COMMENT ⊗   VALID 00006 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	begin "fntpl"
C00004 00003	open files
C00007 00004	fntfile array is dynamically allocated
C00008 00005	do font-wide stuff
C00010 00006	get character dimensions
C00012 ENDMK
C⊗;
begin "fntpl"
comment This program takes a .FNT file and generates a .PL file for it.
	Based on TFDRD, written by FML.  Modified by DRF to take TFM files
	and make PL files, also to run on TENEX/TOPS20;

require "⊂⊃<>" delimiters;
define ! = ⊂comment⊃;
define crlf = ⊂('15&'12)⊃, tab = ⊂('11&'0)⊃;

define WAITS=true, TENEX=false;

IFC TENEX THENC
define inchwl="intty";
ENDC

integer array fontinfo[0:127];  	! .TFX information table;
integer i, charaddr;

integer baseline, rowsfromtop, datarowcount;
integer width, height, depth;

real convert, designsize;
real slant, space, spacestretch, spaceshrink, xheight, quad, extraspace;

integer ichan, ochan, iflg, br;
string filename, ext, ppn, s;

integer array infoarray[0:5];		! array for FILEINFO call;
integer fntsize;
comment open files;

IFC WAITS THENC
ttyup (true);				! convert terminal input to upper case;
ENDC
setbreak (1, ".[", null, "IR");		! scan for filename;
setbreak (2, "[", null, "IR");		! scan for ext;

open (ichan ← getchan, "DSK", 8, 19, 0, 0, 0, 0);

while true do begin "get font filename"
    print ("font: ");
    s ← inchwl;				! parse filespec;
    if not length(s) then call (1, "exit");
    filename ← scan (s, 1, br);
    ext ← if br = "." then scan (s, 2, br) else ".FNT";
    ppn ← s;

    lookup (ichan, filename & ext & ppn, iflg);
    if not iflg then done "get font filename";

    if not length(ppn) then begin
	lookup (ichan, filename & ext & "[XGP,SYS]", iflg);
	if not iflg then done "get font filename";
    end;

    print ("file not found: ", filename & ext & ppn, crlf);
end "get font filename";

IFC WAITS THENC
fileinfo (infoarray);	! get size of file just looked up;
ENDC

comment open output file;

open (ochan ← getchan, "DSK", 0, 0, 19, 0, 0, 0);
ext ← ".PL"; ppn←null;
print ("output filename (default = ", filename & ext, "):  ");
s ← inchwl;
if length(s) then begin
    filename ← scan (s, 1, br);
    if br = "." then ext ← scan (s, 2, br);
    ppn ← s;
    end;
enter (ochan, filename & ext & ppn, iflg);
if iflg then begin print("Couldn't write on ",filename&ext); call(1,"exit"); end;

comment fntfile array is dynamically allocated;

IFC WAITS THENC
fntsize ← -1 * (infoarray[3] ash -18);
ENDC
IFC TENEX THENC
fntsize ← (sizef(ichan)+1)*512;
ENDC

begin "inputfnt"
integer array fntfile[0:fntsize-1];	! array to hold .FNT file;
label startover;

arryin (ichan, fntfile[0], fntsize);	! read in .FNT file;
release (ichan);

comment do font-wide stuff;

print("Design size? "); designsize←cvd(inchwl); comment fix this;
baseline ← fntfile['203];	! logical height above baseline;
convert ← 300*designsize/72.27;	! imp-pixels to ems;
! convert ← 3.6*designsize;	! xgp-pixels to ems;
define flt(x) = ⊂cvf(x/convert)⊃;

slant ← 0.;
space ← (fntfile[" "] lsh -18);
spacestretch ← space/2.;
spaceshrink ← space/2.;
	charaddr ← fntfile["x"] land '777777;
	rowsfromtop ← (fntfile[charaddr+1] lsh -18) land '777;
xheight←if charaddr then ((baseline - rowsfromtop) max 0) else 0;
quad ← 2.*(fntfile["0"] lsh -18);
extraspace ← space/2.;

cprint(ochan,
	"(FAMILY FNT)",crlf,
	"(DESIGNSIZE R ",cvf(designsize),")",crlf,
	"(SEVENBITSAFEFLAG TRUE)",crlf,
	"(FONTDIMEN",crlf,
		tab,"(SLANT R ",cvf(slant),")",crlf,
		tab,"(SPACE R ",flt(space),")",crlf,
		tab,"(STRETCH R ",flt(spacestretch),")",crlf,
		tab,"(SHRINK R ",flt(spaceshrink),")",crlf,
		tab,"(XHEIGHT R ",flt(xheight),")",crlf,
		tab,"(QUAD R ",flt(quad),")",crlf,
		tab,"(EXTRASPACE R ",flt(extraspace),")",crlf,
		tab,")",crlf);

comment get character dimensions;

for i ← 0 step 1 until 127 do begin "get character dimensions"
	charaddr ← fntfile[i] land '777777;
					! starting address of character definition;
	if charaddr = 0 then continue "get character dimensions";
					! character not present;
	rowsfromtop ← (fntfile[charaddr+1] lsh -18) land '777;
	datarowcount ← fntfile[charaddr+1] land '777777;
	width ← fntfile[i] lsh -18;
	height ← (baseline - rowsfromtop) max 0;
	depth ← (datarowcount - (baseline - rowsfromtop)) max 0;
	cprint(ochan,
		"(CHARACTER ", if "0" leq i leq "9" or "a" leq i leq "z"
							or "A" leq i leq "Z"
				then "C "&i else "O "&cvos(i),crlf,
			tab,"(CHARWD R ",flt(width),")",crlf,
			tab,"(CHARHT R ",flt(height),")",crlf,
			tab,"(CHARDP R ",flt(depth),")",crlf,
			tab,")",crlf);
	end "get character dimensions";

end "inputfnt";

release (ochan);

end "fntpl"